Happy Moments

Arpita Shah and Tian Zheng

HappyDB is a corpus of 100,000 crowd-sourced happy moments via Amazon’s Mechanical Turk. You can read more about it on https://arxiv.org/abs/1801.07746.

Here, we explore this data set and try to answer the question, “What makes people happy?”

Step 0 - Load all the required libraries

From the packages’ descriptions:


library(tidyverse)
library(tidytext)
library(DT)
library(scales)
library(wordcloud2)
library(gridExtra)
library(ngram)
library(shiny) 

Step 1 - Load the processed text data along with demographic information on contributors

We use the processed data for our analysis and combine it with the demographic information available.

hm_data <- read_csv("../output/processed_moments.csv")

urlfile<-'https://raw.githubusercontent.com/rit-public/HappyDB/master/happydb/data/demographic.csv'
demo_data <- read_csv(urlfile)

Combine both the data sets and keep the required columns for analysis

We select a subset of the data that satisfies specific row conditions.

hm_data <- hm_data %>%
  inner_join(demo_data, by = "wid") %>%
  select(wid,
         original_hm,
         gender, 
         marital, 
         parenthood,
         reflection_period,
         age, 
         country, 
         ground_truth_category, 
         text) %>%
  mutate(count = sapply(hm_data$text, wordcount)) %>%
  filter(gender %in% c("m", "f")) %>%
  filter(marital %in% c("single", "married")) %>%
  filter(parenthood %in% c("n", "y")) %>%
  filter(reflection_period %in% c("24h", "3m")) %>%
  mutate(reflection_period = fct_recode(reflection_period, 
                                        months_3 = "3m", hours_24 = "24h"))
datatable(hm_data)
Warning: It seems your data is too big for client-side DataTables. You may consider server-side processing: https://rstudio.github.io/DT/server.htmlWarning: It seems your data is too big for client-side DataTables. You may consider server-side processing: https://rstudio.github.io/DT/server.html

Create a bag of words using the text data

bag_of_words <-  hm_data %>%
  unnest_tokens(word, text)

word_count <- bag_of_words %>%
  count(word, sort = TRUE)

Create bigrams using the text data

hm_bigrams <- hm_data %>%
  filter(count != 1) %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

bigram_counts <- hm_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>%
  count(word1, word2, sort = TRUE)

Specify the user interface for the R Shiny app

We want each tab to have its own controls for input and so Shiny’s “navbarPage()” layout works the best. We have the first tab visualizing the overall data, second one for scatterplots comparing the proportion of words within categories, third one highlighting the most frequently appearing bigrams based on categories and the last tab to explore the actual happy moments.

ui <- navbarPage("What makes people happy?",
                 tabPanel("Overview",
                          
                          titlePanel(h1("Most Frequent Occurrences",
                                        align = "center")),
                          
                          sidebarLayout(
                            sidebarPanel(
                              sliderInput(inputId = "topWordcloud",
                                          label = "Number of terms for word cloud:",
                                          min = 5,
                                          max = 100,
                                          value = 50),
                              br(),
                              br(),
                              
                              checkboxInput(inputId = "topFreqB",
                                            label = "Plot Bar Chart",
                                            value = F),
                              sliderInput(inputId = "topBarchart",
                                          label = "Number of terms for bar chart:",
                                          min = 1,
                                          max = 25,
                                          value = 10),
                              br(),
                              br(),
                              
                              checkboxInput(inputId = "topFreqN",
                                            label = "Plot Network Graph",
                                            value = F),
                              sliderInput(inputId = "topNetwork",
                                          label = "Number of edges for network graph:",
                                          min = 1,
                                          max = 150,
                                          value = 50)
                            ),
                            
                            mainPanel(
                              wordcloud2Output(outputId = "WC"),
                              plotOutput(outputId = "figure")
                            )
                          )
                 ),
                 
                 tabPanel("Individual Terms",
                          
                          titlePanel(h1("Comparison of Proportions",
                                        align = "center")),
                          
                          sidebarLayout(
                            sidebarPanel(
                              selectInput(inputId = "attribute",
                                          label = "Select the attribute:",
                                          choices = c("Gender" = "gender",
                                                      "Marital Status" = "marital",
                                                      "Parenthood" = "parenthood",
                                                      "Reflection Period" = "reflection_period")
                              )
                            ),
                            
                            mainPanel(
                              plotOutput(outputId = "scatter")
                            )
                          )
                 ),
                 
                 tabPanel("Pair of Words",
                          
                          titlePanel(h1("Most Frequent Bigrams",
                                        align = "center")),
                          
                          sidebarLayout(
                            sidebarPanel(
                              selectInput(inputId = "factor",
                                          label = "Select the attribute:",
                                          choices = c("Gender" = "gender",
                                                      "Marital Status" = "marital",
                                                      "Parenthood" = "parenthood",
                                                      "Reflection Period" = "reflection_period")
                              ),
                              numericInput(inputId = "topBigrams",
                                          label = "Number of top pairs to view:",
                                          min = 1,
                                          max = 25,
                                          value = 10)
                            ),
                            
                            mainPanel(
                              plotOutput(outputId = "bar")
                            )
                          )
                 ),
                 
                 tabPanel("Data",
                          DT::dataTableOutput("table")
                          )
)

Develop the server for the R Shiny app

This shiny app visualizes summary of data and displays the data table itself.

server <- function(input, output, session) {
  
  pt1 <- reactive({
    if(!input$topFreqB) return(NULL)
    word_count %>%
      slice(1:input$topBarchart) %>%
      mutate(word = reorder(word, n)) %>%
      ggplot(aes(word, n)) +
      geom_col() +
      xlab(NULL) +
      ylab("Word Frequency")+
      coord_flip()
  })
  
  pt2 <- reactive({
    if(!input$topFreqN) return(NULL)
    bigram_graph <- bigram_counts %>%
      slice(1:input$topNetwork) %>%
      graph_from_data_frame()
    
    set.seed(123)
    
    x <- grid::arrow(type = "closed", length = unit(.1, "inches"))
    
    ggraph(bigram_graph, layout = "fr") +
      geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                     arrow = x, end_cap = circle(.05, 'inches')) +
      geom_node_point(color = "skyblue", size = 3) +
      geom_node_text(aes(label = name), repel = TRUE) +
      theme_void()
  })
  
  output$WC <- renderWordcloud2({
    
    word_count %>%
      slice(1:input$topWordcloud) %>%
      wordcloud2(size = 0.6,
                 rotateRatio = 0)
    
  })
  
  output$figure <- renderPlot(height = 500, width = 500, {
    
    ptlist <- list(pt1(),pt2())
    ptlist <- ptlist[!sapply(ptlist, is.null)]
    if(length(ptlist)==0) return(NULL)
    
    lay <- rbind(c(1,1),
                 c(2,2))
    
    grid.arrange(grobs = ptlist, layout_matrix = lay)
  })
  
  
  
  selectedAttribute <- reactive({
    list(atr = input$attribute)
  })
  
  output$scatter <- renderPlot({
    temp <- bag_of_words %>%
      count(!!as.name(selectedAttribute()$atr), word) %>%
      group_by(!!as.name(selectedAttribute()$atr)) %>%
      mutate(proportion = n / sum(n)) %>% 
      select(-n) %>% 
      spread(!!as.name(selectedAttribute()$atr), proportion)
    
      ggplot(temp, 
             aes_string(x = colnames(temp)[2], y = colnames(temp)[3]),
             color = abs(colnames(temp)[3] - colnames(temp)[2])) +
      geom_abline(color = "gray40", lty = 2) +
      geom_jitter(alpha = 0.1, size = 1, width = 0.3, height = 0.3) +
      geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +
      scale_x_log10(labels = percent_format()) +
      scale_y_log10(labels = percent_format()) +
      scale_color_gradient(limits = c(0, 0.001), low = "darkslategray4", high = "gray75") +
      theme(legend.position="none")
  })
  
  
  
  selectedBigram <- reactive({
    list(var = input$factor)
  })
  
  output$bar <- renderPlot({
    hm_bigrams %>%
      count(!!as.name(selectedBigram()$var), bigram, sort = TRUE) %>%
      group_by(!!as.name(selectedBigram()$var)) %>%
      top_n(input$topBigrams) %>%
      ungroup() %>%
      mutate(bigram = reorder(bigram, n)) %>%
      ggplot(aes(bigram, n, fill = !!as.name(selectedBigram()$var))) +
      geom_col(show.legend = FALSE) +
      facet_wrap(as.formula(paste("~", selectedBigram()$var)), ncol = 2, scales = "free") +
      coord_flip()
  })
  
  
  output$table <- DT::renderDataTable({
    DT::datatable(hm_data)
  })
}

Run the R Shiny app

shinyApp(ui, server)
  188: %>%
  187: <reactive:pt2> [#17]
  185: .func
  182: contextFunc
  181: env$runWith
  174: ctx$run
  173: self$.updateValue
  171: pt2
  170: renderPlot [#44]
  168: func
  128: drawPlot
  114: <reactive:plotObj>
   98: drawReactive
   85: renderFunc
   84: output$figure
    3: runApp
    2: print.shiny.appobj
    1: <Anonymous>
NA
LS0tDQp0aXRsZTogIkhhcHB5IE1vbWVudHMiDQphdXRob3I6ICJBcnBpdGEgU2hhaCBhbmQgVGlhbiBaaGVuZyINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KcnVudGltZTogc2hpbnkNCi0tLQ0KDQpIYXBweURCIGlzIGEgY29ycHVzIG9mIDEwMCwwMDAgY3Jvd2Qtc291cmNlZCBoYXBweSBtb21lbnRzIHZpYSBBbWF6b24ncyBNZWNoYW5pY2FsIFR1cmsuIFlvdSBjYW4gcmVhZCBtb3JlIGFib3V0IGl0IG9uIDxodHRwczovL2FyeGl2Lm9yZy9hYnMvMTgwMS4wNzc0Nj4uDQoNCkhlcmUsIHdlIGV4cGxvcmUgdGhpcyBkYXRhIHNldCBhbmQgdHJ5IHRvIGFuc3dlciB0aGUgcXVlc3Rpb24sICJXaGF0IG1ha2VzIHBlb3BsZSBoYXBweT8iDQoNCiMjIyBTdGVwIDAgLSBMb2FkIGFsbCB0aGUgcmVxdWlyZWQgbGlicmFyaWVzDQoNCkZyb20gdGhlIHBhY2thZ2VzJyBkZXNjcmlwdGlvbnM6DQoNCi0gICBgdGlkeXZlcnNlYCBpcyBhbiBvcGluaW9uYXRlZCBjb2xsZWN0aW9uIG9mIFIgcGFja2FnZXMgZGVzaWduZWQgZm9yIGRhdGEgc2NpZW5jZS4gQWxsIHBhY2thZ2VzIHNoYXJlIGFuIHVuZGVybHlpbmcgZGVzaWduIHBoaWxvc29waHksIGdyYW1tYXIsIGFuZCBkYXRhIHN0cnVjdHVyZXM7DQotICAgYHRpZHl0ZXh0YCBhbGxvd3MgdGV4dCBtaW5pbmcgdXNpbmcgJ2RwbHlyJywgJ2dncGxvdDInLCBhbmQgb3RoZXIgdGlkeSB0b29sczsNCi0gICBgRFRgIHByb3ZpZGVzIGFuIFIgaW50ZXJmYWNlIHRvIHRoZSBKYXZhU2NyaXB0IGxpYnJhcnkgRGF0YVRhYmxlczsNCi0gICBgc2NhbGVzYCBtYXAgZGF0YSB0byBhZXN0aGV0aWNzLCBhbmQgcHJvdmlkZSBtZXRob2RzIGZvciBhdXRvbWF0aWNhbGx5IGRldGVybWluaW5nIGJyZWFrcyBhbmQgbGFiZWxzIGZvciBheGVzIGFuZCBsZWdlbmRzOw0KLSAgIGB3b3JkY2xvdWQyYCBwcm92aWRlcyBhbiBIVE1MNSBpbnRlcmZhY2UgdG8gd29yZGNsb3VkIGZvciBkYXRhIHZpc3VhbGl6YXRpb247DQotICAgYGdyaWRFeHRyYWAgY29udGFpbnMgbWlzY2VsbGFuZW91cyBmdW5jdGlvbnMgZm9yICJncmlkIiBncmFwaGljczsNCi0gICBgbmdyYW1gIGlzIGZvciBjb25zdHJ1Y3Rpbmcgbi1ncmFtcyAoInRva2VuaXppbmciKSwgYXMgd2VsbCBhcyBnZW5lcmF0aW5nIG5ldyB0ZXh0IGJhc2VkIG9uIHRoZSBuLWdyYW0gc3RydWN0dXJlIG9mIGEgZ2l2ZW4gdGV4dCBpbnB1dCAoImJhYmJsaW5nIik7DQotICAgYFNoaW55YCBpcyBhbiBSIHBhY2thZ2UgdGhhdCBtYWtlcyBpdCBlYXN5IHRvIGJ1aWxkIGludGVyYWN0aXZlIHdlYiBhcHBzIHN0cmFpZ2h0IGZyb20gUjsNCg0KYGBge3IgbG9hZCBsaWJyYXJpZXMsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9DQoNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeSh0aWR5dGV4dCkNCmxpYnJhcnkoRFQpDQpsaWJyYXJ5KHNjYWxlcykNCmxpYnJhcnkod29yZGNsb3VkMikNCmxpYnJhcnkoZ3JpZEV4dHJhKQ0KbGlicmFyeShuZ3JhbSkNCmxpYnJhcnkoc2hpbnkpIA0KYGBgDQoNCiMjIyBTdGVwIDEgLSBMb2FkIHRoZSBwcm9jZXNzZWQgdGV4dCBkYXRhIGFsb25nIHdpdGggZGVtb2dyYXBoaWMgaW5mb3JtYXRpb24gb24gY29udHJpYnV0b3JzDQoNCldlIHVzZSB0aGUgcHJvY2Vzc2VkIGRhdGEgZm9yIG91ciBhbmFseXNpcyBhbmQgY29tYmluZSBpdCB3aXRoIHRoZSBkZW1vZ3JhcGhpYyBpbmZvcm1hdGlvbiBhdmFpbGFibGUuDQoNCmBgYHtyIGxvYWQgZGF0YSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmhtX2RhdGEgPC0gcmVhZF9jc3YoIi4uL291dHB1dC9wcm9jZXNzZWRfbW9tZW50cy5jc3YiKQ0KDQp1cmxmaWxlPC0naHR0cHM6Ly9yYXcuZ2l0aHVidXNlcmNvbnRlbnQuY29tL3JpdC1wdWJsaWMvSGFwcHlEQi9tYXN0ZXIvaGFwcHlkYi9kYXRhL2RlbW9ncmFwaGljLmNzdicNCmRlbW9fZGF0YSA8LSByZWFkX2Nzdih1cmxmaWxlKQ0KYGBgDQoNCiMjIyBDb21iaW5lIGJvdGggdGhlIGRhdGEgc2V0cyBhbmQga2VlcCB0aGUgcmVxdWlyZWQgY29sdW1ucyBmb3IgYW5hbHlzaXMNCg0KV2Ugc2VsZWN0IGEgc3Vic2V0IG9mIHRoZSBkYXRhIHRoYXQgc2F0aXNmaWVzIHNwZWNpZmljIHJvdyBjb25kaXRpb25zLg0KDQpgYGB7ciBjb21iaW5pbmcgZGF0YSwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmhtX2RhdGEgPC0gaG1fZGF0YSAlPiUNCiAgaW5uZXJfam9pbihkZW1vX2RhdGEsIGJ5ID0gIndpZCIpICU+JQ0KICBzZWxlY3Qod2lkLA0KICAgICAgICAgb3JpZ2luYWxfaG0sDQogICAgICAgICBnZW5kZXIsIA0KICAgICAgICAgbWFyaXRhbCwgDQogICAgICAgICBwYXJlbnRob29kLA0KICAgICAgICAgcmVmbGVjdGlvbl9wZXJpb2QsDQogICAgICAgICBhZ2UsIA0KICAgICAgICAgY291bnRyeSwgDQogICAgICAgICBncm91bmRfdHJ1dGhfY2F0ZWdvcnksIA0KICAgICAgICAgdGV4dCkgJT4lDQogIG11dGF0ZShjb3VudCA9IHNhcHBseShobV9kYXRhJHRleHQsIHdvcmRjb3VudCkpICU+JQ0KICBmaWx0ZXIoZ2VuZGVyICVpbiUgYygibSIsICJmIikpICU+JQ0KICBmaWx0ZXIobWFyaXRhbCAlaW4lIGMoInNpbmdsZSIsICJtYXJyaWVkIikpICU+JQ0KICBmaWx0ZXIocGFyZW50aG9vZCAlaW4lIGMoIm4iLCAieSIpKSAlPiUNCiAgZmlsdGVyKHJlZmxlY3Rpb25fcGVyaW9kICVpbiUgYygiMjRoIiwgIjNtIikpICU+JQ0KICBtdXRhdGUocmVmbGVjdGlvbl9wZXJpb2QgPSBmY3RfcmVjb2RlKHJlZmxlY3Rpb25fcGVyaW9kLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtb250aHNfMyA9ICIzbSIsIGhvdXJzXzI0ID0gIjI0aCIpKQ0KYGBgDQoNCmBgYHtyfQ0KZGF0YXRhYmxlKGhtX2RhdGEpDQpgYGANCg0KIyMjIENyZWF0ZSBhIGJhZyBvZiB3b3JkcyB1c2luZyB0aGUgdGV4dCBkYXRhDQoNCmBgYHtyIGJhZyBvZiB3b3Jkcywgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCmJhZ19vZl93b3JkcyA8LSAgaG1fZGF0YSAlPiUNCiAgdW5uZXN0X3Rva2Vucyh3b3JkLCB0ZXh0KQ0KDQp3b3JkX2NvdW50IDwtIGJhZ19vZl93b3JkcyAlPiUNCiAgY291bnQod29yZCwgc29ydCA9IFRSVUUpDQpgYGANCg0KIyMjIENyZWF0ZSBiaWdyYW1zIHVzaW5nIHRoZSB0ZXh0IGRhdGENCg0KYGBge3IgYmlncmFtLCB3YXJuaW5nPUZBTFNFLCBtZXNzYWdlPUZBTFNFfQ0KaG1fYmlncmFtcyA8LSBobV9kYXRhICU+JQ0KICBmaWx0ZXIoY291bnQgIT0gMSkgJT4lDQogIHVubmVzdF90b2tlbnMoYmlncmFtLCB0ZXh0LCB0b2tlbiA9ICJuZ3JhbXMiLCBuID0gMikNCg0KYmlncmFtX2NvdW50cyA8LSBobV9iaWdyYW1zICU+JQ0KICBzZXBhcmF0ZShiaWdyYW0sIGMoIndvcmQxIiwgIndvcmQyIiksIHNlcCA9ICIgIikgJT4lDQogIGNvdW50KHdvcmQxLCB3b3JkMiwgc29ydCA9IFRSVUUpDQpgYGANCg0KIyMjIFNwZWNpZnkgdGhlIHVzZXIgaW50ZXJmYWNlIGZvciB0aGUgUiBTaGlueSBhcHANCg0KV2Ugd2FudCBlYWNoIHRhYiB0byBoYXZlIGl0cyBvd24gY29udHJvbHMgZm9yIGlucHV0IGFuZCBzbyBTaGlueSdzICJuYXZiYXJQYWdlKCkiIGxheW91dCB3b3JrcyB0aGUgYmVzdC4gV2UgaGF2ZSB0aGUgZmlyc3QgdGFiIHZpc3VhbGl6aW5nIHRoZSBvdmVyYWxsIGRhdGEsIHNlY29uZCBvbmUgZm9yIHNjYXR0ZXJwbG90cyBjb21wYXJpbmcgdGhlIHByb3BvcnRpb24gb2Ygd29yZHMgd2l0aGluIGNhdGVnb3JpZXMsIHRoaXJkIG9uZSBoaWdobGlnaHRpbmcgdGhlIG1vc3QgZnJlcXVlbnRseSBhcHBlYXJpbmcgYmlncmFtcyBiYXNlZCBvbiBjYXRlZ29yaWVzIGFuZCB0aGUgbGFzdCB0YWIgdG8gZXhwbG9yZSB0aGUgYWN0dWFsIGhhcHB5IG1vbWVudHMuDQoNCmBgYHtyIHNoaW55IFVJLCB3YXJuaW5nPUZBTFNFLCBtZXNzYWdlPUZBTFNFfQ0KdWkgPC0gbmF2YmFyUGFnZSgiV2hhdCBtYWtlcyBwZW9wbGUgaGFwcHk/IiwNCiAgICAgICAgICAgICAgICAgdGFiUGFuZWwoIk92ZXJ2aWV3IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHRpdGxlUGFuZWwoaDEoIk1vc3QgRnJlcXVlbnQgT2NjdXJyZW5jZXMiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGFsaWduID0gImNlbnRlciIpKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHNpZGViYXJMYXlvdXQoDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgc2lkZWJhclBhbmVsKA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2xpZGVySW5wdXQoaW5wdXRJZCA9ICJ0b3BXb3JkY2xvdWQiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiTnVtYmVyIG9mIHRlcm1zIGZvciB3b3JkIGNsb3VkOiIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtaW4gPSA1LA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWF4ID0gMTAwLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdmFsdWUgPSA1MCksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBicigpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYnIoKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY2hlY2tib3hJbnB1dChpbnB1dElkID0gInRvcEZyZXFCIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiUGxvdCBCYXIgQ2hhcnQiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2YWx1ZSA9IEYpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2xpZGVySW5wdXQoaW5wdXRJZCA9ICJ0b3BCYXJjaGFydCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsYWJlbCA9ICJOdW1iZXIgb2YgdGVybXMgZm9yIGJhciBjaGFydDoiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbWluID0gMSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1heCA9IDI1LA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdmFsdWUgPSAxMCksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBicigpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYnIoKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY2hlY2tib3hJbnB1dChpbnB1dElkID0gInRvcEZyZXFOIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiUGxvdCBOZXR3b3JrIEdyYXBoIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdmFsdWUgPSBGKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHNsaWRlcklucHV0KGlucHV0SWQgPSAidG9wTmV0d29yayIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsYWJlbCA9ICJOdW1iZXIgb2YgZWRnZXMgZm9yIG5ldHdvcmsgZ3JhcGg6IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1pbiA9IDEsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtYXggPSAxNTAsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2YWx1ZSA9IDUwKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgbWFpblBhbmVsKA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgd29yZGNsb3VkMk91dHB1dChvdXRwdXRJZCA9ICJXQyIpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgcGxvdE91dHB1dChvdXRwdXRJZCA9ICJmaWd1cmUiKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KICAgICAgICAgICAgICAgICApLA0KICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgdGFiUGFuZWwoIkluZGl2aWR1YWwgVGVybXMiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgdGl0bGVQYW5lbChoMSgiQ29tcGFyaXNvbiBvZiBQcm9wb3J0aW9ucyIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYWxpZ24gPSAiY2VudGVyIikpLA0KICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgc2lkZWJhckxheW91dCgNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICBzaWRlYmFyUGFuZWwoDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBzZWxlY3RJbnB1dChpbnB1dElkID0gImF0dHJpYnV0ZSIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsYWJlbCA9ICJTZWxlY3QgdGhlIGF0dHJpYnV0ZToiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgY2hvaWNlcyA9IGMoIkdlbmRlciIgPSAiZ2VuZGVyIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJNYXJpdGFsIFN0YXR1cyIgPSAibWFyaXRhbCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiUGFyZW50aG9vZCIgPSAicGFyZW50aG9vZCIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiUmVmbGVjdGlvbiBQZXJpb2QiID0gInJlZmxlY3Rpb25fcGVyaW9kIikNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICkNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICApLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1haW5QYW5lbCgNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHBsb3RPdXRwdXQob3V0cHV0SWQgPSAic2NhdHRlciIpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICApDQogICAgICAgICAgICAgICAgICksDQogICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICB0YWJQYW5lbCgiUGFpciBvZiBXb3JkcyIsDQogICAgICAgICAgICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICAgICAgICAgICB0aXRsZVBhbmVsKGgxKCJNb3N0IEZyZXF1ZW50IEJpZ3JhbXMiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGFsaWduID0gImNlbnRlciIpKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgDQogICAgICAgICAgICAgICAgICAgICAgICAgIHNpZGViYXJMYXlvdXQoDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgc2lkZWJhclBhbmVsKA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2VsZWN0SW5wdXQoaW5wdXRJZCA9ICJmYWN0b3IiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbGFiZWwgPSAiU2VsZWN0IHRoZSBhdHRyaWJ1dGU6IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNob2ljZXMgPSBjKCJHZW5kZXIiID0gImdlbmRlciIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAiTWFyaXRhbCBTdGF0dXMiID0gIm1hcml0YWwiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlBhcmVudGhvb2QiID0gInBhcmVudGhvb2QiLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIlJlZmxlY3Rpb24gUGVyaW9kIiA9ICJyZWZsZWN0aW9uX3BlcmlvZCIpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICApLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbnVtZXJpY0lucHV0KGlucHV0SWQgPSAidG9wQmlncmFtcyIsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBsYWJlbCA9ICJOdW1iZXIgb2YgdG9wIHBhaXJzIHRvIHZpZXc6IiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIG1pbiA9IDEsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBtYXggPSAyNSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlID0gMTApDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICBtYWluUGFuZWwoDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICBwbG90T3V0cHV0KG91dHB1dElkID0gImJhciIpDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KICAgICAgICAgICAgICAgICAgICAgICAgICApDQogICAgICAgICAgICAgICAgICksDQogICAgICAgICAgICAgICAgIA0KICAgICAgICAgICAgICAgICB0YWJQYW5lbCgiRGF0YSIsDQogICAgICAgICAgICAgICAgICAgICAgICAgIERUOjpkYXRhVGFibGVPdXRwdXQoInRhYmxlIikNCiAgICAgICAgICAgICAgICAgICAgICAgICAgKQ0KKQ0KYGBgDQoNCiMjIyBEZXZlbG9wIHRoZSBzZXJ2ZXIgZm9yIHRoZSBSIFNoaW55IGFwcA0KDQpUaGlzIHNoaW55IGFwcCB2aXN1YWxpemVzIHN1bW1hcnkgb2YgZGF0YSBhbmQgZGlzcGxheXMgdGhlIGRhdGEgdGFibGUgaXRzZWxmLg0KDQpgYGB7ciBzaGlueSBzZXJ2ZXIsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9DQpzZXJ2ZXIgPC0gZnVuY3Rpb24oaW5wdXQsIG91dHB1dCwgc2Vzc2lvbikgew0KICANCiAgcHQxIDwtIHJlYWN0aXZlKHsNCiAgICBpZighaW5wdXQkdG9wRnJlcUIpIHJldHVybihOVUxMKQ0KICAgIHdvcmRfY291bnQgJT4lDQogICAgICBzbGljZSgxOmlucHV0JHRvcEJhcmNoYXJ0KSAlPiUNCiAgICAgIG11dGF0ZSh3b3JkID0gcmVvcmRlcih3b3JkLCBuKSkgJT4lDQogICAgICBnZ3Bsb3QoYWVzKHdvcmQsIG4pKSArDQogICAgICBnZW9tX2NvbCgpICsNCiAgICAgIHhsYWIoTlVMTCkgKw0KICAgICAgeWxhYigiV29yZCBGcmVxdWVuY3kiKSsNCiAgICAgIGNvb3JkX2ZsaXAoKQ0KICB9KQ0KICANCiAgcHQyIDwtIHJlYWN0aXZlKHsNCiAgICBpZighaW5wdXQkdG9wRnJlcU4pIHJldHVybihOVUxMKQ0KICAgIGJpZ3JhbV9ncmFwaCA8LSBiaWdyYW1fY291bnRzICU+JQ0KICAgICAgc2xpY2UoMTppbnB1dCR0b3BOZXR3b3JrKSAlPiUNCiAgICAgIGdyYXBoX2Zyb21fZGF0YV9mcmFtZSgpDQogICAgDQogICAgc2V0LnNlZWQoMTIzKQ0KICAgIA0KICAgIHggPC0gZ3JpZDo6YXJyb3codHlwZSA9ICJjbG9zZWQiLCBsZW5ndGggPSB1bml0KC4xLCAiaW5jaGVzIikpDQogICAgDQogICAgZ2dyYXBoKGJpZ3JhbV9ncmFwaCwgbGF5b3V0ID0gImZyIikgKw0KICAgICAgZ2VvbV9lZGdlX2xpbmsoYWVzKGVkZ2VfYWxwaGEgPSBuKSwgc2hvdy5sZWdlbmQgPSBGQUxTRSwNCiAgICAgICAgICAgICAgICAgICAgIGFycm93ID0geCwgZW5kX2NhcCA9IGNpcmNsZSguMDUsICdpbmNoZXMnKSkgKw0KICAgICAgZ2VvbV9ub2RlX3BvaW50KGNvbG9yID0gInNreWJsdWUiLCBzaXplID0gMykgKw0KICAgICAgZ2VvbV9ub2RlX3RleHQoYWVzKGxhYmVsID0gbmFtZSksIHJlcGVsID0gVFJVRSkgKw0KICAgICAgdGhlbWVfdm9pZCgpDQogIH0pDQogIA0KICBvdXRwdXQkV0MgPC0gcmVuZGVyV29yZGNsb3VkMih7DQogICAgDQogICAgd29yZF9jb3VudCAlPiUNCiAgICAgIHNsaWNlKDE6aW5wdXQkdG9wV29yZGNsb3VkKSAlPiUNCiAgICAgIHdvcmRjbG91ZDIoc2l6ZSA9IDAuNiwNCiAgICAgICAgICAgICAgICAgcm90YXRlUmF0aW8gPSAwKQ0KICAgIA0KICB9KQ0KICANCiAgb3V0cHV0JGZpZ3VyZSA8LSByZW5kZXJQbG90KGhlaWdodCA9IDUwMCwgd2lkdGggPSA1MDAsIHsNCiAgICANCiAgICBwdGxpc3QgPC0gbGlzdChwdDEoKSxwdDIoKSkNCiAgICBwdGxpc3QgPC0gcHRsaXN0WyFzYXBwbHkocHRsaXN0LCBpcy5udWxsKV0NCiAgICBpZihsZW5ndGgocHRsaXN0KT09MCkgcmV0dXJuKE5VTEwpDQogICAgDQogICAgbGF5IDwtIHJiaW5kKGMoMSwxKSwNCiAgICAgICAgICAgICAgICAgYygyLDIpKQ0KICAgIA0KICAgIGdyaWQuYXJyYW5nZShncm9icyA9IHB0bGlzdCwgbGF5b3V0X21hdHJpeCA9IGxheSkNCiAgfSkNCiAgDQogIA0KICANCiAgc2VsZWN0ZWRBdHRyaWJ1dGUgPC0gcmVhY3RpdmUoew0KICAgIGxpc3QoYXRyID0gaW5wdXQkYXR0cmlidXRlKQ0KICB9KQ0KICANCiAgb3V0cHV0JHNjYXR0ZXIgPC0gcmVuZGVyUGxvdCh7DQogICAgdGVtcCA8LSBiYWdfb2Zfd29yZHMgJT4lDQogICAgICBjb3VudCghIWFzLm5hbWUoc2VsZWN0ZWRBdHRyaWJ1dGUoKSRhdHIpLCB3b3JkKSAlPiUNCiAgICAgIGdyb3VwX2J5KCEhYXMubmFtZShzZWxlY3RlZEF0dHJpYnV0ZSgpJGF0cikpICU+JQ0KICAgICAgbXV0YXRlKHByb3BvcnRpb24gPSBuIC8gc3VtKG4pKSAlPiUgDQogICAgICBzZWxlY3QoLW4pICU+JSANCiAgICAgIHNwcmVhZCghIWFzLm5hbWUoc2VsZWN0ZWRBdHRyaWJ1dGUoKSRhdHIpLCBwcm9wb3J0aW9uKQ0KICAgIA0KICAgICAgZ2dwbG90KHRlbXAsIA0KICAgICAgICAgICAgIGFlc19zdHJpbmcoeCA9IGNvbG5hbWVzKHRlbXApWzJdLCB5ID0gY29sbmFtZXModGVtcClbM10pLA0KICAgICAgICAgICAgIGNvbG9yID0gYWJzKGNvbG5hbWVzKHRlbXApWzNdIC0gY29sbmFtZXModGVtcClbMl0pKSArDQogICAgICBnZW9tX2FibGluZShjb2xvciA9ICJncmF5NDAiLCBsdHkgPSAyKSArDQogICAgICBnZW9tX2ppdHRlcihhbHBoYSA9IDAuMSwgc2l6ZSA9IDEsIHdpZHRoID0gMC4zLCBoZWlnaHQgPSAwLjMpICsNCiAgICAgIGdlb21fdGV4dChhZXMobGFiZWwgPSB3b3JkKSwgY2hlY2tfb3ZlcmxhcCA9IFRSVUUsIHZqdXN0ID0gMS41KSArDQogICAgICBzY2FsZV94X2xvZzEwKGxhYmVscyA9IHBlcmNlbnRfZm9ybWF0KCkpICsNCiAgICAgIHNjYWxlX3lfbG9nMTAobGFiZWxzID0gcGVyY2VudF9mb3JtYXQoKSkgKw0KICAgICAgc2NhbGVfY29sb3JfZ3JhZGllbnQobGltaXRzID0gYygwLCAwLjAwMSksIGxvdyA9ICJkYXJrc2xhdGVncmF5NCIsIGhpZ2ggPSAiZ3JheTc1IikgKw0KICAgICAgdGhlbWUobGVnZW5kLnBvc2l0aW9uPSJub25lIikNCiAgfSkNCiAgDQogIA0KICANCiAgc2VsZWN0ZWRCaWdyYW0gPC0gcmVhY3RpdmUoew0KICAgIGxpc3QodmFyID0gaW5wdXQkZmFjdG9yKQ0KICB9KQ0KICANCiAgb3V0cHV0JGJhciA8LSByZW5kZXJQbG90KHsNCiAgICBobV9iaWdyYW1zICU+JQ0KICAgICAgY291bnQoISFhcy5uYW1lKHNlbGVjdGVkQmlncmFtKCkkdmFyKSwgYmlncmFtLCBzb3J0ID0gVFJVRSkgJT4lDQogICAgICBncm91cF9ieSghIWFzLm5hbWUoc2VsZWN0ZWRCaWdyYW0oKSR2YXIpKSAlPiUNCiAgICAgIHRvcF9uKGlucHV0JHRvcEJpZ3JhbXMpICU+JQ0KICAgICAgdW5ncm91cCgpICU+JQ0KICAgICAgbXV0YXRlKGJpZ3JhbSA9IHJlb3JkZXIoYmlncmFtLCBuKSkgJT4lDQogICAgICBnZ3Bsb3QoYWVzKGJpZ3JhbSwgbiwgZmlsbCA9ICEhYXMubmFtZShzZWxlY3RlZEJpZ3JhbSgpJHZhcikpKSArDQogICAgICBnZW9tX2NvbChzaG93LmxlZ2VuZCA9IEZBTFNFKSArDQogICAgICBmYWNldF93cmFwKGFzLmZvcm11bGEocGFzdGUoIn4iLCBzZWxlY3RlZEJpZ3JhbSgpJHZhcikpLCBuY29sID0gMiwgc2NhbGVzID0gImZyZWUiKSArDQogICAgICBjb29yZF9mbGlwKCkNCiAgfSkNCiAgDQogIA0KICBvdXRwdXQkdGFibGUgPC0gRFQ6OnJlbmRlckRhdGFUYWJsZSh7DQogICAgRFQ6OmRhdGF0YWJsZShobV9kYXRhKQ0KICB9KQ0KfQ0KYGBgDQoNCiMjIyBSdW4gdGhlIFIgU2hpbnkgYXBwDQoNCmBgYHtyIHNoaW55IGFwcCwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0NCnNoaW55QXBwKHVpLCBzZXJ2ZXIpDQpgYGANCg==